home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
PSORTST.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
2KB
|
77 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
' QuickSort derived from "partition sort" algorithm given in
' "Algorithms & Data Structures" by Niklaus Wirth, 1986
TYPE Partition
Lft AS INTEGER
Rht AS INTEGER
END TYPE
SUB PSortSt (Ptr%(), Array() AS STRING, Elements%, CapsCount%)
DIM x AS STRING
DIM SortStack(1 TO 16) AS Partition
S% = 1
SortStack(1).Lft = 1
SortStack(1).Rht = Elements%
DO
L% = SortStack(S%).Lft
R% = SortStack(S%).Rht
S% = S% - 1
DO
i% = L%
j% = R%
IF CapsCount% THEN
x = Array(Ptr%((L% + R%) \ 2))
DO
WHILE Array(Ptr%(i%)) < x
i% = i% + 1
WEND
WHILE x < Array(Ptr%(j%))
j% = j% - 1
WEND
IF i% <= j% THEN
SWAP Ptr%(i%), Ptr%(j%)
i% = i% + 1
j% = j% - 1
END IF
LOOP UNTIL i% > j%
ELSE
x = UCASE$(Array(Ptr%((L% + R%) \ 2)))
DO
WHILE UCASE$(Array(Ptr%(i%))) < x
i% = i% + 1
WEND
WHILE x < UCASE$(Array(Ptr%(j%)))
j% = j% - 1
WEND
IF i% <= j% THEN
SWAP Ptr%(i%), Ptr%(j%)
i% = i% + 1
j% = j% - 1
END IF
LOOP UNTIL i% > j%
END IF
IF j% - L% < R% - i% THEN
IF i% < R% THEN
S% = S% + 1
SortStack(S%).Lft = i%
SortStack(S%).Rht = R%
END IF
R% = j%
ELSE
IF L% < j% THEN
S% = S% + 1
SortStack(S%).Lft = L%
SortStack(S%).Rht = j%
END IF
L% = i%
END IF
LOOP UNTIL L% >= R%
LOOP WHILE S%
END SUB